home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / bipl.zip / PROCS.ZIP / PERMUTE.ICN < prev    next >
Text File  |  1992-09-28  |  2KB  |  95 lines
  1. ############################################################################
  2. #
  3. #    File:     permute.icn
  4. #
  5. #    Subject:  Procedures for permutations, combinations, and such
  6. #
  7. #    Author:   Ralph E. Griswold and Kurt A. Welgehausen
  8. #
  9. #    Date:     September 2, 1991
  10. #
  11. ###########################################################################
  12. #
  13. #     These procedures produce various rearrangements of strings of
  14. #  characters:
  15. #
  16. #     comb(s,i)       generates the combinations characters from s taken
  17. #                     i at a time.
  18. #
  19. #     permute(s)      generates all the permutations of the string s.
  20. #
  21. #     menader(s,n)    produces a "meandering" string which contains all
  22. #                     n-tuples of characters of s.
  23. #
  24. #     csort(s)        produces the characters of s in lexical order.
  25. #
  26. #     ochars(s)       produces the unique characters of s in the order they
  27. #                     first appear in s.
  28. #
  29. #     schars(s)       produces the unique characters of s in lexical order.
  30. #
  31. ############################################################################
  32.  
  33. procedure comb(s,i)
  34.    local j
  35.  
  36.    if i < 1 then fail
  37.    suspend if i = 1 then !s
  38.       else s[j := 1 to *s - i + 1] || comb(s[j + 1:0],i - 1)
  39. end
  40.  
  41. procedure permute(s)
  42.    local i
  43.  
  44.    if *s = 0 then return ""
  45.    suspend s[i := 1 to *s] || permute(s[1:i] || s[i+1:0])
  46. end
  47.  
  48. procedure meander(alpha,n)
  49.    local result, trial, t, i, c
  50.  
  51.    i := *alpha
  52.    t := n - 1
  53.    result := repl(alpha[1],t)            # base string
  54.  
  55.    while c := alpha[i] do {            # try a character
  56.       result ? {                # get the potential n-tuple
  57.          tab(-t)
  58.          trial := tab(0) || c
  59.          }
  60.       if result ? find(trial) then         # duplicate, work back
  61.          i -:= 1
  62.       else {
  63.          result ||:= c                # add it
  64.          i := *alpha                # and start from end again
  65.          }
  66.       }
  67.  
  68.    return result
  69.  
  70. end
  71.  
  72. procedure csort(s)
  73.    local c, s1
  74.  
  75.    s1 := ""
  76.    every c := !cset(s) do
  77.       every find(c,s) do
  78.          s1 ||:= c
  79.    return s1
  80. end
  81.  
  82. procedure schars(s)
  83.    return string(cset(s))
  84. end
  85.  
  86. procedure ochars(w)
  87.    local out, c
  88.  
  89.    out := ""
  90.    every c := !w do
  91.     if not find(c,out) then
  92.         out ||:= c
  93.    return out
  94. end
  95.